home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Score_Edit2060794162007.psc / Score Editor / ScoreEditor.ctl < prev   
Text File  |  2007-04-16  |  25KB  |  907 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ctlScoreEdit 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00FFFFFF&
  5.    BorderStyle     =   1  'Fest Einfach
  6.    ClientHeight    =   7710
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   11880
  10.    BeginProperty Font 
  11.       Name            =   "capella3-invertiert"
  12.       Size            =   20.25
  13.       Charset         =   2
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ScaleHeight     =   514
  20.    ScaleMode       =   3  'Pixel
  21.    ScaleWidth      =   792
  22.    Begin VB.PictureBox picBuffer 
  23.       AutoRedraw      =   -1  'True
  24.       BackColor       =   &H00FFFFFF&
  25.       BorderStyle     =   0  'Kein
  26.       BeginProperty Font 
  27.          Name            =   "capella3"
  28.          Size            =   20.25
  29.          Charset         =   2
  30.          Weight          =   400
  31.          Underline       =   0   'False
  32.          Italic          =   0   'False
  33.          Strikethrough   =   0   'False
  34.       EndProperty
  35.       Height          =   13500
  36.       Left            =   1560
  37.       ScaleHeight     =   900
  38.       ScaleMode       =   3  'Pixel
  39.       ScaleWidth      =   620
  40.       TabIndex        =   0
  41.       Top             =   6240
  42.       Visible         =   0   'False
  43.       Width           =   9300
  44.    End
  45.    Begin VB.Timer tmrScroll 
  46.       Enabled         =   0   'False
  47.       Interval        =   100
  48.       Left            =   5280
  49.       Top             =   4320
  50.    End
  51.    Begin VB.Timer tmrMetro 
  52.       Enabled         =   0   'False
  53.       Interval        =   1
  54.       Left            =   4440
  55.       Top             =   4200
  56.    End
  57.    Begin VB.Timer tmrPlay 
  58.       Enabled         =   0   'False
  59.       Interval        =   1
  60.       Left            =   3960
  61.       Top             =   4200
  62.    End
  63.    Begin VB.Image imgBow2 
  64.       Height          =   60
  65.       Left            =   5880
  66.       Picture         =   "ScoreEditor.ctx":0000
  67.       Top             =   2880
  68.       Width           =   600
  69.    End
  70.    Begin VB.Image imgBow 
  71.       Height          =   60
  72.       Left            =   5880
  73.       Picture         =   "ScoreEditor.ctx":0222
  74.       Top             =   2400
  75.       Width           =   600
  76.    End
  77. End
  78. Attribute VB_Name = "ctlScoreEdit"
  79. Attribute VB_GlobalNameSpace = False
  80. Attribute VB_Creatable = True
  81. Attribute VB_PredeclaredId = False
  82. Attribute VB_Exposed = False
  83. Dim Space As Single
  84.  
  85. Dim Chords(21) As String
  86. Dim Tones(36) As String
  87.  
  88. Private Type Note
  89.     NotePos As Integer
  90.     Note As Integer
  91.     Length As Integer
  92.     Up As Boolean
  93.     Down As Boolean
  94.     No As Boolean
  95.     Point As Boolean
  96.     Join As Boolean
  97.     Text As String
  98.     Bar As Integer
  99.     Triple As Boolean
  100.     Bow As Boolean
  101.     Chord As String
  102.     Splitter As Boolean
  103. End Type
  104.  
  105. Dim MaxLength As Long
  106.  
  107. Dim Notes As New Collection
  108. Dim NoteCollection() As Note
  109.  
  110. Dim NoteLength As Integer
  111. Dim Up As Boolean
  112. Dim Down As Boolean
  113. Dim No As Boolean
  114. Dim Point As Boolean
  115. Dim Join As Boolean
  116. Dim TripleNote As Boolean
  117. Dim Bow As Boolean
  118. Dim Pitch As Integer
  119.  
  120. Dim CursorX As Long
  121. Dim SelBoundLeft As Long
  122. Dim SelBoundRight As Long
  123.  
  124. Dim TimeSignature As Single
  125. Dim Signature As Integer
  126. Dim Scroll As Long
  127. Dim Additional As Long
  128.  
  129. Dim Tone As Integer
  130. Dim PlayTempo As Integer
  131. Dim NoteCounter As Long
  132. Dim PlayCounter1 As Single
  133. Dim PlayCounter2 As Long
  134. Dim AktivFis As String
  135. Dim AktivB As String
  136. Dim CurrentChord As String
  137.  
  138. Dim mTitle As String * 60
  139. Dim mComposer As String * 60
  140.  
  141. Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As Long, ByVal hBitmap As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  142. Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As Long) As Long
  143. Private Declare Function SetCaretPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long
  144. Private Declare Function HideCaret Lib "user32" (ByVal hwnd As Long) As Long
  145. Private Declare Function LockWindowUpdate Lib "user32.dll" (ByVal hwndLock As Long) As Long
  146.  
  147. Public Event ScrollChanged(Value As Long)
  148.  
  149. Public Property Let Title(ByVal Data As String)
  150. mTitle = Data
  151. End Property
  152.  
  153. Public Property Get Title() As String
  154. Title = TrimString(mTitle)
  155. End Property
  156.  
  157. Public Property Let Composer(ByVal Data As String)
  158. mComposer = Data
  159. End Property
  160.  
  161. Public Property Get Composer() As String
  162. Composer = TrimString(mComposer)
  163. End Property
  164.  
  165. Public Sub Save(Filename As String)
  166. Dim i As Long
  167. ReDim NoteCollection(1 To Notes.Count)
  168. For i = 1 To UBound(NoteCollection)
  169.     NoteCollection(i).NotePos = Notes(i).NotePos
  170.     NoteCollection(i).Note = Notes(i).Note
  171.     NoteCollection(i).Length = Notes(i).Length
  172.     NoteCollection(i).Up = Notes(i).Up
  173.     NoteCollection(i).Down = Notes(i).Down
  174.     NoteCollection(i).No = Notes(i).No
  175.     NoteCollection(i).Point = Notes(i).Point
  176.     NoteCollection(i).Join = Notes(i).Join
  177.     NoteCollection(i).Text = Notes(i).Text
  178.     NoteCollection(i).Bar = Notes(i).Bar
  179.     NoteCollection(i).Triple = Notes(i).Triple
  180.     NoteCollection(i).Bow = Notes(i).Bow
  181.     NoteCollection(i).Chord = Notes(i).Chord
  182.     NoteCollection(i).Splitter = Notes(i).Splitter
  183. Next i
  184. Open Filename For Binary Access Write As #1
  185.     Put #1, , TimeSignature
  186.     Put #1, , Signature
  187.     Put #1, , UBound(NoteCollection)
  188.     Put #1, , NoteCollection
  189.     Put #1, , mTitle
  190.     Put #1, , mComposer
  191. Close #1
  192. End Sub
  193.  
  194. Public Sub Load(Filename As String)
  195. Dim i As Long
  196. Dim Count As Long
  197.  
  198. Set Notes = New Collection
  199. Open Filename For Binary Access Read As #1
  200.         'Get #1, , mTitle
  201.         Get #1, , TimeSignature
  202.         Get #1, , Signature
  203.         Get #1, , Count
  204.         ReDim NoteCollection(1 To Count)
  205.         Get #1, , NoteCollection
  206.         Get #1, , mTitle
  207.         Get #1, , mComposer
  208. Close #1
  209. mTitle = TrimString(mTitle)
  210. mComposer = TrimString(mComposer)
  211.  
  212. For i = 1 To UBound(NoteCollection)
  213.     Dim Note As New clsNotes
  214.     Note.NotePos = NoteCollection(i).NotePos
  215.     Note.Note = NoteCollection(i).Note
  216.     Note.Length = NoteCollection(i).Length
  217.     Note.Up = NoteCollection(i).Up
  218.     Note.Down = NoteCollection(i).Down
  219.     Note.No = NoteCollection(i).No
  220.     Note.Point = NoteCollection(i).Point
  221.     Note.Join = NoteCollection(i).Join
  222.     Note.Text = NoteCollection(i).Text
  223.     Note.Bar = NoteCollection(i).Bar
  224.     Note.Triple = NoteCollection(i).Triple
  225.     Note.Bow = NoteCollection(i).Bow
  226.     Note.Chord = NoteCollection(i).Chord
  227.     Note.Splitter = NoteCollection(i).Splitter
  228.     Notes.Add Note
  229.     Set Note = Nothing
  230. Next i
  231. CursorX = 1
  232. SelBoundLeft = 0
  233. SelBoundRight = 0
  234. Call DrawLines
  235. End Sub
  236.  
  237. Public Sub NewSheet()
  238. Set Notes = New Collection
  239. TimeSignature = 1
  240. Signature = 0
  241. CursorX = 1
  242. Call DrawLines
  243. Call UserControl.SetFocus
  244. End Sub
  245.  
  246. Public Sub SavePictureFile(Filename As String, BarsPerRow As Integer)
  247. Dim i As Long
  248. Dim x As Long
  249. Dim Value As Long
  250. Dim Counter1 As Single
  251. Dim Counter2 As Long
  252. Dim Last As Long
  253. Dim Top As Long
  254.  
  255. Call LockWindowUpdate(UserControl.hwnd)
  256. picBuffer.FontBold = True
  257. picBuffer.Font.Size = 16
  258. picBuffer.Font.Name = "Arial"
  259. picBuffer.CurrentY = 5
  260. picBuffer.CurrentX = (595 / 2) - (picBuffer.TextWidth(Title) / 2)
  261. picBuffer.Print Title
  262. picBuffer.FontBold = False
  263. picBuffer.Font.Size = 10
  264. picBuffer.CurrentY = 30
  265. picBuffer.CurrentX = (595 / 2) - (picBuffer.TextWidth(Composer) / 2)
  266. picBuffer.Print Composer
  267.  
  268. Last = 0
  269. Counter1 = 0
  270. Counter2 = 0
  271. Top = 50
  272. For i = 1 To Notes.Count
  273.     Value = Notes(i).Length
  274.     If Notes(i).Triple = True Then
  275.         Counter1 = Counter1 + (2 * (1 / Value)) / 3
  276.     Else
  277.         Counter1 = Counter1 + (1 / Value)
  278.     End If
  279.  
  280.     If Notes(i).Point = True Then Counter1 = Counter1 + ((1 / Value) / 2)
  281.  
  282.     If Counter1 > 0 And Counter1 = TimeSignature Then
  283.         Counter1 = 0
  284.         Counter2 = Counter2 + 1
  285.  
  286.         If Counter2 = BarsPerRow Then
  287.             Space = (595 - 45 - Additional) / (i - Last)
  288.             Exit For
  289.         End If
  290.     End If
  291. Next i
  292. Call DrawLines(Space * (Last))
  293.  
  294. Last = i
  295.  
  296. Call picBuffer.PaintPicture(UserControl.Image, 10, Top, , , , , 590)
  297. picBuffer.Line (10, 50 + Top)-(picBuffer.Width, 50 + Top)
  298. picBuffer.Line (10, 57 + Top)-(picBuffer.Width, 57 + Top)
  299. picBuffer.Line (10, 64 + Top)-(picBuffer.Width, 64 + Top)
  300. picBuffer.Line (10, 71 + Top)-(picBuffer.Width, 71 + Top)
  301. picBuffer.Line (10, 78 + Top)-(picBuffer.Width, 78 + Top)
  302. If Counter2 = BarsPerRow Then picBuffer.Line (picBuffer.Width - 1, 50 + Top)-(picBuffer.Width - 1, 78 + Top)
  303. Top = Top + 130
  304.  
  305. Do Until Last >= Notes.Count
  306.     Counter1 = 0
  307.     Counter2 = 0
  308.     For i = Last + 1 To Notes.Count
  309.         Value = Notes(i).Length
  310.         If Notes(i).Triple = True Then
  311.             Counter1 = Counter1 + (2 * (1 / Value)) / 3
  312.         Else
  313.             Counter1 = Counter1 + (1 / Value)
  314.         End If
  315.  
  316.         If Notes(i).Point = True Then Counter1 = Counter1 + ((1 / Value) / 2)
  317.  
  318.         If Counter1 > 0 And Counter1 = TimeSignature Then
  319.             Counter1 = 0
  320.             Counter2 = Counter2 + 1
  321.  
  322.             If Counter2 = BarsPerRow Then
  323.                 Space = (595) / (i - Last)
  324.                 Exit For
  325.             End If
  326.         End If
  327.     Next i
  328.    
  329.     Call DrawLines(((Space) * (Last + 1)) + 16 + Additional)
  330.     Last = i
  331.     Call picBuffer.PaintPicture(UserControl.Image, 10, Top, , , , , 590)
  332.     picBuffer.Line (0, 50 + Top)-(picBuffer.Width, 50 + Top)
  333.     picBuffer.Line (0, 57 + Top)-(picBuffer.Width, 57 + Top)
  334.     picBuffer.Line (0, 64 + Top)-(picBuffer.Width, 64 + Top)
  335.     picBuffer.Line (0, 71 + Top)-(picBuffer.Width, 71 + Top)
  336.     picBuffer.Line (0, 78 + Top)-(picBuffer.Width, 78 + Top)
  337.     If Counter2 = BarsPerRow Then picBuffer.Line (picBuffer.Width - 1, 50 + Top)-(picBuffer.Width - 1, 78 + Top)
  338.     
  339.     Top = Top + 130
  340. Loop
  341. Call SavePicture(picBuffer.Image, Filename)
  342. Space = 45
  343. Call DrawLines
  344. Call LockWindowUpdate(False)
  345. End Sub
  346.  
  347. Private Sub tmrPlay_Timer()
  348. Dim Beats As Single
  349. Dim Add As Integer
  350. Dim Key As Integer
  351. Dim val2 As Long
  352.  
  353. On Error Resume Next
  354.  
  355. If Notes(NoteCounter).Bow = False Then
  356.     Call StopNote(Tone)
  357. End If
  358. If NoteCounter >= Notes.Count Then tmrPlay.Enabled = False: tmrMetro.Enabled = False: tmrScroll.Enabled = False
  359. NoteCounter = NoteCounter + 1
  360. Beats = 60 / PlayTempo '120
  361. Beats = 1000 * Beats
  362.  
  363. If Notes(NoteCounter).Length = 4 Then
  364.     If Notes(NoteCounter).Point = True Then tmrPlay.Interval = Beats + (Beats / 2) Else tmrPlay.Interval = Beats
  365. ElseIf Notes(NoteCounter).Length = 2 Then
  366.    If Notes(NoteCounter).Point = True Then tmrPlay.Interval = (Beats * 2) + (Beats) Else tmrPlay.Interval = Beats * 2
  367. ElseIf Notes(NoteCounter).Length = 1 Then
  368.    If Notes(NoteCounter).Point = True Then tmrPlay.Interval = (Beats * 4) + ((Beats * 4) / 2) Else tmrPlay.Interval = Beats * 4
  369. ElseIf Notes(NoteCounter).Length = 8 Then
  370.    If Notes(NoteCounter).Point = True Then tmrPlay.Interval = (Beats / 2) + ((Beats / 2) / 2) Else tmrPlay.Interval = Beats / 2
  371. ElseIf Notes(NoteCounter).Length = 16 Then
  372.    If Notes(NoteCounter).Point = True Then tmrPlay.Interval = (Beats / 4) + ((Beats / 4) / 2) Else tmrPlay.Interval = Beats / 4
  373. End If
  374. If Notes(NoteCounter).Triple = True Then tmrPlay.Interval = (tmrPlay.Interval / 3) * 2
  375.     
  376. If Notes(NoteCounter).Chord <> "" Then
  377.     If NoteCounter <= Notes.Count Then
  378.         CurrentChord = Notes(NoteCounter).Chord
  379.         Call SetChord(CurrentChord)
  380.     End If
  381. End If
  382.     
  383. If InStr(1, AktivFis, Notes(NoteCounter).Note) > 0 Then
  384.     If Notes(NoteCounter).Up = False Then Add = 1
  385.     If Notes(NoteCounter).No = True Then
  386.         AktivFis = Replace(AktivFis, Notes(NoteCounter).Note, "")
  387.         Add = 0
  388.     End If
  389. ElseIf Notes(NoteCounter).Up = True Then
  390.     Add = 1
  391. End If
  392.  
  393. If InStr(1, AktivB, Notes(NoteCounter).Note) > 0 Then
  394.     If Notes(NoteCounter).Down = False Then Add = -1
  395.     If Notes(NoteCounter).No = True Then
  396.         AktivB = Replace(AktivB, Notes(NoteCounter).Note, "")
  397.         Add = 0
  398.     End If
  399. ElseIf Notes(NoteCounter).Down = True Then
  400.     Add = -1
  401. End If
  402. If Notes(NoteCounter).Up = True Then AktivFis = AktivFis & " " & Notes(NoteCounter).Note
  403. If Notes(NoteCounter).Down = True Then AktivB = AktivB & " " & Notes(NoteCounter).Note
  404.  
  405. Key = Notes(NoteCounter).Note
  406. Select Case Signature
  407.     Case 1
  408.         If Key = -3 Then Add = 1
  409.         If Key = 4 Then Add = 1
  410.         If Key = 11 Then Add = 1
  411.     Case 2
  412.         If Key = -3 Then Add = 1
  413.         If Key = 4 Then Add = 1
  414.         If Key = 11 Then Add = 1
  415.         
  416.         If Key = -6 Then Add = 1
  417.         If Key = 1 Then Add = 1
  418.         If Key = 8 Then Add = 1
  419.     Case 3
  420.         If Key = -3 Then Add = 1
  421.         If Key = 4 Then Add = 1
  422.         If Key = 11 Then Add = 1
  423.         
  424.         If Key = -6 Then Add = 1
  425.         If Key = 1 Then Add = 1
  426.         If Key = 8 Then Add = 1
  427.         
  428.         If Key = -3 Then Add = 1
  429.         If Key = 5 Then Add = 1
  430.         If Key = 12 Then Add = 1
  431.     Case 4
  432.         If Key = -3 Then Add = 1
  433.         If Key = 4 Then Add = 1
  434.         If Key = 11 Then Add = 1
  435.         
  436.         If Key = -7 Then Add = 1
  437.         If Key = 1 Then Add = 1
  438.         If Key = 8 Then Add = 1
  439.         
  440.         If Key = -3 Then Add = 1
  441.         If Key = 5 Then Add = 1
  442.         If Key = 12 Then Add = 1
  443.         
  444.         If Key = -6 Then Add = 1
  445.         If Key = 2 Then Add = 1
  446.         If Key = 9 Then Add = 1
  447.     Case 5
  448.         If Key = -3 Then Add = 1
  449.         If Key = 4 Then Add = 1
  450.         If Key = 11 Then Add = 1
  451.         
  452.         If Key = -7 Then Add = 1
  453.         If Key = 1 Then Add = 1
  454.         If Key = 8 Then Add = 1
  455.         
  456.         If Key = -3 Then Add = 1
  457.         If Key = 5 Then Add = 1
  458.         If Key = 12 Then Add = 1
  459.         
  460.         If Key = -6 Then Add = 1
  461.         If Key = 2 Then Add = 1
  462.         If Key = 9 Then Add = 1
  463.         
  464.         If Key = -1 Then Add = 1
  465.         If Key = 6 Then Add = 1
  466.         If Key = 13 Then Add = 1
  467. End Select
  468.  
  469. Select Case Notes(NoteCounter).Note
  470. Case -6
  471.      Tone = 12 + Add
  472. Case -5
  473.       Tone = 14 + Add
  474. Case -4
  475.  Tone = 16 + Add
  476. Case -3
  477.       Tone = 17 + Add
  478. Case -2
  479.    Tone = 19 + Add
  480. Case -1
  481. Tone = 21 + Add
  482.     Case 0
  483. Tone = 23 + Add
  484.     Case 1
  485. Tone = 24 + Add
  486.     Case 2
  487. Tone = 26 + Add
  488. Case 3
  489. Tone = 28 + Add
  490.  Case 4
  491. Tone = 29 + Add
  492.    Case 5
  493. Tone = 31 + Add
  494.    Case 6
  495. Tone = 33 + Add
  496.   Case 7
  497. Tone = 35 + Add
  498.   Case 8
  499. Tone = 36 + Add
  500.   Case 9
  501. Tone = 38 + Add
  502.    Case 10
  503. Tone = 40 + Add
  504.    Case 11
  505. Tone = 41 + Add
  506.   Case 12
  507. Tone = 43 + Add
  508.    Case 13
  509. Tone = 45 + Add
  510.   Case 14
  511. Tone = 47 + Add
  512.     Case 15
  513. Tone = 48 + Add
  514.     End Select
  515. Tone = Tone + 12
  516.  
  517. If NoteCounter > Notes.Count Then tmrPlay.Enabled = False: Exit Sub
  518. If Notes(NoteCounter).Note <> 1000 Then
  519.     If Notes(NoteCounter - 1).Bow = False Then
  520.     Call StartNote(Tone, 127)
  521.     End If
  522. End If
  523. CursorX = NoteCounter
  524. Call SetCaretPos((Space * CursorX) + 15 - Scroll + Additional, 45)
  525.  
  526. val2 = Notes(NoteCounter).Length
  527. If Notes(NoteCounter).Triple = True Then
  528.     PlayCounter1 = PlayCounter1 + (2 * (1 / val2)) / 3
  529. Else
  530.     PlayCounter1 = PlayCounter1 + (1 / val2)
  531. End If
  532.  
  533. If Notes(NoteCounter).Point = True Then PlayCounter1 = PlayCounter1 + ((1 / val2) / 2)
  534.  
  535. If PlayCounter1 > 0 And PlayCounter1 = TimeSignature Then
  536.     PlayCounter1 = 0
  537.     AktivFis = ""
  538.     AktivB = ""
  539. End If
  540. End Sub
  541.  
  542. Private Sub tmrMetro_Timer()
  543. Dim Beats As Single
  544.  
  545. On Error Resume Next
  546. PlayCounter2 = PlayCounter2 + 1
  547. If PlayCounter2 = 4 Then PlayCounter2 = 0
  548. Beats = 60 / PlayTempo '120
  549. Beats = 1000 * Beats
  550. tmrMetro.Interval = Beats
  551. Call StopMetro(9)
  552. Call StartMetro(9)
  553. If PlayCounter2 = 1 Then
  554.     'Call StopDong(10)
  555.     'Call StartDong(10)
  556. End If
  557. End Sub
  558.  
  559. Private Sub tmrScroll_Timer()
  560. If (Space * CursorX) + 15 - Scroll > (UserControl.Width / Screen.TwipsPerPixelX) - 50 Then
  561.     RaiseEvent ScrollChanged((UserControl.Width / Screen.TwipsPerPixelX) - 100)
  562. End If
  563. End Sub
  564.  
  565. Private Sub UserControl_DblClick()
  566. Dim Text As String
  567. Text = InputBox("Text eingeben (" & CursorX & "):", "Liedtext eingeben", Notes(CursorX).Text)
  568. If Text <> "" Then Notes(CursorX).Text = Text
  569. Call CreateCaret(UserControl.hwnd, 0, 2, 40)
  570. Call DrawLines(Scroll)
  571. Call ShowCaret(UserControl.hwnd)
  572. Call UserControl.SetFocus
  573. End Sub
  574.  
  575. Public Sub AddChord(Chord As String)
  576. Notes(CursorX).Chord = Chord
  577. Call CreateCaret(UserControl.hwnd, 0, 2, 40)
  578. Call DrawLines(Scroll)
  579. Call ShowCaret(UserControl.hwnd)
  580. Call UserControl.SetFocus
  581. End Sub
  582.  
  583. Public Sub StopPlay()
  584. NoteCounter = 0
  585. tmrPlay.Enabled = False
  586. 'tmrMetro.Enabled = False
  587. tmrScroll.Enabled = False
  588. Call StopNote(Tone)
  589. End Sub
  590.  
  591. Public Sub Play(Tempo As Integer)
  592. Call MidiInitialize
  593. NoteCounter = CursorX - 1
  594. AktivFis = ""
  595. AktivB = ""
  596. PlayCounter1 = 0
  597. PlayCounter2 = 0
  598. PlayTempo = Tempo
  599. If Notes(1).Chord <> "" Then CurrentChord = Notes(1).Chord Else CurrentChord = ""
  600. tmrPlay.Interval = 1
  601. 'tmrMetro.Interval = 1
  602. 'tmrMetro.Enabled = True
  603. tmrPlay.Enabled = True
  604. tmrScroll.Enabled = True
  605. End Sub
  606.  
  607. Private Sub UserControl_EnterFocus()
  608. Call CreateCaret(UserControl.hwnd, 0, 2, 40)
  609. Call ShowCaret(UserControl.hwnd)
  610. End Sub
  611.  
  612. Private Sub UserControl_Initialize()
  613. Chords(0) = ":1;5;8"
  614. Chords(1) = "6:1;5;8;10"
  615. Chords(2) = "7:1;5;8;11"
  616. Chords(3) = "maj7:1;5;8;12"
  617. Chords(4) = "9:1;5;8;11;15"
  618. Chords(5) = "m:1;4;8"
  619. Chords(6) = "m6:1;4;8;10"
  620. Chords(7) = "m7:1;4;8;11"
  621. Chords(8) = "m maj7:1;4;8;12"
  622. Chords(9) = "m9:1;4;8;11;15"
  623. Chords(10) = "dim:1;4;7"
  624. Chords(11) = "aug:1;5;9"
  625. Chords(12) = "sus4:1;6;8"
  626. Chords(13) = "add9:1;5;8;15"
  627. Chords(14) = "11:1;5;8;11;15;18"
  628. Chords(15) = "13:1;5;8;11;15;18;22"
  629. Chords(16) = "6add9:1;5;8;10;15"
  630. Chords(17) = "-5:1;5;7"
  631. Chords(18) = "7-5:1;5;7;11"
  632. Chords(19) = "7 maj5:1;5;9;11"
  633. Chords(20) = "7 sus4:1;6;8;11"
  634. Chords(21) = "maj9:1;5;8;12;15"
  635.  
  636. Tones(0) = "C"
  637. Tones(1) = "C#/Db"
  638. Tones(2) = "D"
  639. Tones(3) = "D#/Eb"
  640. Tones(4) = "E"
  641. Tones(5) = "F"
  642. Tones(6) = "F#/Gb"
  643. Tones(7) = "G"
  644. Tones(8) = "G#/Ab"
  645. Tones(9) = "A"
  646. Tones(10) = "A#/Bb"
  647. Tones(11) = "B"
  648. Tones(12) = "C"
  649. Tones(13) = "C#/Db"
  650. Tones(14) = "D"
  651. Tones(15) = "D#/Eb"
  652. Tones(16) = "E"
  653. Tones(17) = "F"
  654. Tones(18) = "F#/Gb"
  655. Tones(19) = "G"
  656. Tones(20) = "G#/Ab"
  657. Tones(21) = "A"
  658. Tones(22) = "A#/Bb"
  659. Tones(23) = "B"
  660. Tones(24) = "C"
  661. Tones(25) = "C#/Db"
  662. Tones(26) = "D"
  663. Tones(27) = "D#/Eb"
  664. Tones(28) = "E"
  665. Tones(29) = "F"
  666. Tones(30) = "F#/Gb"
  667. Tones(31) = "G"
  668. Tones(32) = "G#/Ab"
  669. Tones(33) = "A"
  670. Tones(34) = "A#/Bb"
  671. Tones(35) = "B"
  672. Tones(36) = "C"
  673.  
  674. Space = 45
  675. TimeSignature = 1
  676. Signature = 0
  677. Call DrawLines
  678. End Sub
  679.  
  680. Sub SetChord(Chord As String)
  681. Dim i As Integer
  682. Dim x As Integer
  683. Dim Chord1() As String
  684. Dim Chord2() As String
  685. Dim Base As Integer
  686. Dim NewChord As String
  687. Dim NewChord2 As String
  688. Dim Upper As Integer
  689. Dim Pitch As Integer
  690. Dim B() As String
  691. Dim T() As String
  692. Dim Tone As String
  693.  
  694. On Error Resume Next
  695. If Chord = "" Then Exit Sub
  696. Pitch = 12
  697.  
  698. If Mid$(Chord, 2, 1) = "#" Or Mid$(Chord, 2, 1) = "b" Then
  699.     NewChord = Left$(Chord, 2)
  700.     NewChord2 = Right(Chord, Len(Chord) - 2)
  701. Else
  702.     NewChord = Left$(Chord, 1)
  703.     NewChord2 = Right(Chord, Len(Chord) - 1)
  704. End If
  705.  
  706. For i = 0 To 21
  707.     T = Split(Tones(i), "/")
  708.     If UBound(T) > 0 Then
  709.         If T(0) = NewChord Then
  710.             Base = i
  711.             Exit For
  712.         ElseIf T(1) = NewChord Then
  713.             Base = i
  714.             Exit For
  715.         End If
  716.     Else
  717.         If Tones(i) = NewChord Then
  718.             Base = i
  719.             Exit For
  720.         End If
  721.     End If
  722. Next i
  723.  
  724. For i = 0 To 21
  725.     B = Split(Chords(i), ":")
  726.     If B(0) = NewChord2 Then
  727.         
  728.         Upper = i
  729.         Exit For
  730.     End If
  731. Next i
  732.  
  733. Chord1 = Split(Chords(Upper), ":")
  734. If UBound(Chord1) > 0 Then Chord2 = Split(Chord1(1), ";")
  735.  
  736. For i = 0 To 36 + 12 + Pitch
  737.     Call StopNote(i)
  738. Next i
  739.  
  740. For i = 0 To 36
  741.     For x = 0 To UBound(Chord2)
  742.         If i + 1 = Chord2(x) + Base Then
  743.             Call StartNote(i + 12 + Pitch, 80)
  744.         End If
  745.     Next x
  746. Next i
  747. End Sub
  748.  
  749. Public Sub ChangeTime(Value As Single)
  750. TimeSignature = Value
  751. Call DrawLines(Scroll)
  752. End Sub
  753.  
  754. Public Sub ChangeSignature(Value As Single)
  755. Signature = Value
  756. Call DrawLines(Scroll)
  757. End Sub
  758.  
  759. Private Sub DrawLines(Optional Val As Long, Optional Start As Long = 1)
  760. Dim i As Long
  761. Dim u As Long
  762. Dim e As Long
  763. Dim Values As Single
  764. Dim Value As Long
  765. Dim NotePos As Integer
  766.  
  767. On Error Resume Next
  768. 'Bildschirm l÷schen und Notenschlⁿssel zeichnen
  769. Call UserControl.Cls
  770. UserControl.DrawWidth = 1
  771. UserControl.CurrentX = 5 - Val
  772. UserControl.CurrentY = 35
  773. UserControl.Print Chr$(65)
  774.  
  775. 'Vorzeichen
  776. Select Case Signature
  777.     Case 0
  778.         Additional = 0
  779.     Case 1
  780.         UserControl.CurrentY = 14
  781.         UserControl.CurrentX = 30 - Val
  782.         UserControl.Print Chr(83)
  783.         Additional = 9
  784.     Case 2
  785.         UserControl.CurrentY = 14
  786.         UserControl.CurrentX = 30 - Val
  787.         UserControl.Print Chr(83)
  788.         
  789.         UserControl.CurrentY = 24
  790.         UserControl.CurrentX = 38 - Val
  791.         UserControl.Print Chr(83)
  792.         Additional = 18
  793.     Case 3
  794.         UserControl.CurrentY = 14
  795.         UserControl.CurrentX = 30 - Val
  796.         UserControl.Print Chr(83)
  797.         
  798.         UserControl.CurrentY = 24
  799.         UserControl.CurrentX = 38 - Val
  800.         UserControl.Print Chr(83)
  801.         
  802.         UserControl.CurrentY = 9
  803.         UserControl.CurrentX = 46 - Val
  804.         UserControl.Print Chr(83)
  805.         Additional = 27
  806.     Case 4
  807.         UserControl.CurrentY = 14
  808.         UserControl.CurrentX = 30 - Val
  809.         UserControl.Print Chr(83)
  810.         
  811.         UserControl.CurrentY = 24
  812.         UserControl.CurrentX = 38 - Val
  813.         UserControl.Print Chr(83)
  814.         
  815.         UserControl.CurrentY = 9
  816.         UserControl.CurrentX = 46 - Val
  817.         UserControl.Print Chr(83)
  818.         
  819.         UserControl.CurrentY = 21
  820.         UserControl.CurrentX = 54 - Val
  821.         UserControl.Print Chr(83)
  822.         Additional = 36
  823.     Case 5
  824.         UserControl.CurrentY = 14
  825.         UserControl.CurrentX = 30 - Val
  826.         UserControl.Print Chr(83)
  827.         
  828.         UserControl.CurrentY = 24
  829.         UserControl.CurrentX = 38 - Val
  830.         UserControl.Print Chr(83)
  831.         
  832.         UserControl.CurrentY = 9
  833.         UserControl.CurrentX = 46 - Val
  834.         UserControl.Print Chr(83)
  835.         
  836.         UserControl.CurrentY = 21
  837.         UserControl.CurrentX = 54 - Val
  838.         UserControl.Print Chr(83)
  839.         
  840.         UserControl.CurrentY = 31
  841.         UserControl.CurrentX = 62 - Val
  842.         UserControl.Print Chr(83)
  843.         Additional = 45
  844. End Select
  845.  
  846. UserControl.CurrentY = 21
  847. UserControl.CurrentX = 30 - Val + Additional
  848.  
  849. 'Takt zeichnen (ZΣhler)
  850. If TimeSignature = 1 Then
  851.     UserControl.Print Chr(52)
  852. ElseIf TimeSignature = 0.75 Then
  853.     UserControl.Print Chr(51)
  854. ElseIf TimeSignature = 0.5 Then
  855.     UserControl.Print Chr(50)
  856. End If
  857. 'Takt zeichnen (Nenner)
  858. UserControl.CurrentY = 35
  859. UserControl.CurrentX = 30 - Val + Additional
  860. UserControl.Print Chr(52)
  861.  
  862. 'Notenlinien zeichnen
  863. UserControl.Line (0, 50)-(UserControl.Width, 50)
  864. UserControl.Line (0, 57)-(UserControl.Width, 57)
  865. UserControl.Line (0, 64)-(UserControl.Width, 64)
  866. UserControl.Line (0, 71)-(UserControl.Width, 71)
  867. UserControl.Line (0, 78)-(UserControl.Width, 78)
  868. MaxLength = 0
  869.  
  870. 'Alle Noten zeichnen
  871. For i = Start To Notes.Count
  872.     NotePos = Notes(i).NotePos
  873.     UserControl.DrawWidth = 1
  874.     
  875.     'Maximale BalkenlΣnge errechnen
  876.     For u = i To Notes.Count
  877.         If Notes(u).Join = True Then
  878.             If Notes(u).Note > MaxLength Then
  879.                MaxLength = Notes(u).Note
  880.             Else
  881.                 MaxLength = MaxLength
  882.             End If
  883.         Else
  884.             Exit For
  885.         End If
  886.     Next u
  887.     'Nur Noten zeichnen, die auf den Bildschirm passen
  888.     If (i * Space + 25 + Additionalntr2e2   If Key = 9 Then Add = y 9 T= y 9 T= y 9 T= y 9 T= y 9 T= y 9 TT= y 9 T= y 9 Tdy 9Theni TT= y 9 T= y 9 Tdy 9Theni TT= y 9 T= y 9 Tdy 9The(uf den Bildschirm passen 9 T= y 9 Tdy 9T-dddddddddd8= y 9 T= y 9 TdddsT-dddddddr
  889.         End2'lliY7(1    End2'lliY7(1    End2'lld2'lliY7(1    En        End23     UserC,1rint Chr(83)
  890.         
  891.         UserControl.CurrentY = 9
  892.         UserControl.CurrentX = 46 - Val
  893.         UserCon1)-(UserControl.Width, 64)
  894. UserControl.LinetX = 38 - Val
  895.         UserControl.Print Chr(83)
  896.         
  897.    4ntY = 9
  898.         UserConY =heniCurrentY = dd n1       od If
  899.     Eu=u9rentY = dd  If
  900.     Eu=u9rentY = dd  If
  901.     Eu=u9rentY =    UserControl.CurrentX = 30 - Val
  902.  f, 64)
  903. Un     Eldy 9Theni TT= y 9o 4ntY = 9
  904.    = 30 - Val71trol.Line (0, 78) 9o 4ntY = 9
  905.    = 30 - Valh = MaxLengthalh = MaxLengthY = y 9o 4ntY= y 9 TdddsT-dddddddr
  906.         End2'lliY7(1   8cs     
  907.    4ntY = 9r2